Function: smie-prec2->grammar
smie-prec2->grammar is a byte-compiled function defined in smie.el.gz.
Signature
(smie-prec2->grammar PREC2)
Documentation
Take a 2D precedence table and turn it into an alist of precedence levels.
PREC2 is a table as returned by smie-precs->prec2 or
smie-bnf->prec2.
Source Code
;; Defined in /usr/src/emacs/lisp/emacs-lisp/smie.el.gz
;; (defun smie-check-grammar (grammar prec2 &optional dummy)
;; (maphash (lambda (k v)
;; (when (consp k)
;; (let ((left (nth 2 (assoc (car k) grammar)))
;; (right (nth 1 (assoc (cdr k) grammar))))
;; (when (and left right)
;; (cond
;; ((< left right) (cl-assert (eq v '<)))
;; ((> left right) (cl-assert (eq v '>)))
;; (t (cl-assert (eq v '=))))))))
;; prec2))
(defun smie-prec2->grammar (prec2)
"Take a 2D precedence table and turn it into an alist of precedence levels.
PREC2 is a table as returned by `smie-precs->prec2' or
`smie-bnf->prec2'."
(declare (pure t))
;; For each operator, we create two "variables" (corresponding to
;; the left and right precedence level), which are represented by
;; cons cells. Those are the very cons cells that appear in the
;; final `table'. The value of each "variable" is kept in the `car'.
(let ((table ())
(csts ())
(eqs ()))
;; From `prec2' we construct a list of constraints between
;; variables (aka "precedence levels"). These can be either
;; equality constraints (in `eqs') or `<' constraints (in `csts').
(maphash (lambda (k v)
(when (consp k)
(let ((tmp (assoc (car k) table))
x y)
(if tmp
(setq x (cddr tmp))
(setq x (cons nil nil))
(push (cons (car k) (cons nil x)) table))
(if (setq tmp (assoc (cdr k) table))
(setq y (cdr tmp))
(setq y (cons nil (cons nil nil)))
(push (cons (cdr k) y) table))
(pcase v
('= (push (cons x y) eqs))
('< (push (cons x y) csts))
('> (push (cons y x) csts))
(_ (error "SMIE error: prec2 has %Sā¦%S which ā {<,+,>}"
k v))))))
prec2)
;; First process the equality constraints.
(let ((eqs eqs))
(while eqs
(let ((from (caar eqs))
(to (cdar eqs)))
(setq eqs (cdr eqs))
(if (eq to from)
nil ;Nothing to do.
(dolist (other-eq eqs)
(if (eq from (cdr other-eq)) (setcdr other-eq to))
(when (eq from (car other-eq))
;; This can happen because of `assoc' settings in precs
;; or because of a rhs like ("op" foo "op").
(setcar other-eq to)))
(dolist (cst csts)
(if (eq from (cdr cst)) (setcdr cst to))
(if (eq from (car cst)) (setcar cst to)))))))
;; Then eliminate trivial constraints iteratively.
(let ((i 0))
(while csts
(let ((rhvs (mapcar #'cdr csts))
(progress nil))
(dolist (cst csts)
(unless (memq (car cst) rhvs)
(setq progress t)
;; We could give each var in a given iteration the same value,
;; but we can also give them arbitrarily different values.
;; Basically, these are vars between which there is no
;; constraint (neither equality nor inequality), so
;; anything will do.
;; We give them arbitrary values, which means that we
;; replace the "no constraint" case with either > or <
;; but not =. The reason we do that is so as to try and
;; distinguish associative operators (which will have
;; left = right).
(unless (caar cst)
(setcar (car cst) i)
;; (smie-check-grammar table prec2 'step1)
(incf i))
(setq csts (delq cst csts))))
(unless progress
(error "Can't resolve the precedence cycle: %s"
(smie-debug--describe-cycle
table (smie-debug--prec2-cycle csts)))))
(incf i 10))
;; Propagate equality constraints back to their sources.
(dolist (eq (nreverse eqs))
(when (null (cadr eq))
;; There's an equality constraint, but we still haven't given
;; it a value: that means it binds tighter than anything else,
;; and it can't be an opener/closer (those don't have equality
;; constraints).
;; So set it here rather than below since doing it below
;; makes it more difficult to obey the equality constraints.
(setcar (cdr eq) i)
(incf i))
(cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
(setcar (car eq) (cadr eq))
;; (smie-check-grammar table prec2 'step2)
)
;; Finally, fill in the remaining vars (which did not appear on the
;; left side of any < constraint).
(dolist (x table)
(unless (nth 1 x)
(setf (nth 1 x) i)
(incf i)) ;See other (incf i) above.
(unless (nth 2 x)
(setf (nth 2 x) i)
(incf i)))) ;See other (incf i) above.
;; Mark closers and openers.
(dolist (x (gethash :smie-open/close-alist prec2))
(let* ((token (car x))
(cons (pcase (cdr x)
('closer (cddr (assoc token table)))
('opener (cdr (assoc token table))))))
;; `cons' can be nil for openers/closers which only contain
;; "atomic" elements.
(when cons
(cl-assert (numberp (car cons)))
(setf (car cons) (list (car cons))))))
(let ((ca (gethash :smie-closer-alist prec2)))
(when ca (push (cons :smie-closer-alist ca) table)))
;; (smie-check-grammar table prec2 'step3)
table))